Almathera Ten Pack 3: CDPD 3/Almathera Ten on Ten - Disc 3: CDPD3.iso/scope/076-100/scopedisk95/calpal/cal-pal.rexx

OS/2 REXX Batch file | 1995-03-19 | 35.1 KB | 1,319 lines

/*
**                       =====>>  Calendar Pal  <<=====
**
**
**
**  Calendar/Planner system written in ARexx
**
**  Written by:    Dan R. Schenck - [phone] - GEnie:  D.SCHENCK
**
**  Version:       1.01
**
**  Last revised:  16-DEC-89
**
**  Note:          Requires RexxArpLib
**
**  A special thanks to Mike Meyer for developing the calendar routine
**  used in this program.
**
*/

parse upper arg month year .

true = 1
false = 0
pm = false
doffx = 31
doffy = 11
sysinfo = "    Calendar Pal v1.01\"
sysinfo = sysinfo || "       Written by:\       Dan Schenck\\"
sysinfo = sysinfo || "     Tulsa, Oklahoma"
OrigConfigfile = "Cal-Pal.cfg"
configfile = OrigConfigfile
database = "Cal-Pal.dbf"
wx1 = 0
wy1 = 0
IconOn = false
ix1 = 515
iy1 = 377
VerifyKey = "FFEE"x||"Cal-Pal v1.01"
OldVerifyKey = "FFEE"x||"Cal-Pal v1.00"
saved = false
daybg=false
pd = false
ym = 0
saving = false
searchstr = ""
seadirection = "Forward"
seayear = "This Year"
seamonth = "This Month"
yeartrigger = false
Lock = false
if showlist('h','SPEAK') then
  do
    voice = true
    SFile = "T:++CP-Speak"
  end
else voice = false

/* Is screen interlace?  If not, we'll have to open our own! */
if ~ScreenLace() then
  do
    newscreen = true
    ScreenID = 'CPS'
  end
else
  do
    newscreen = false
    ScreenID = 'Workbench'
  end

/* Is Cal-Pal already active? */
if show('P',"CALHOST") then
  do
    call PostMsg(wx1+50,wy1+50,"WARNING!!\\Calendar Pal Already Active",ScreenID)
    call delay(200)
    call PostMsg
    exit
  end

/* Make sure all the libraries are there */
if ~show('L',"rexxarplib.library") then
    rtn = addlib('rexxarplib.library',0,-30,0)

if ~show('L',"rexxsupport.library") then
    rtn = addlib('rexxsupport.library',0,-30,0)

if ~show('L',"rexxmathlib.library") then
    rtn = addlib('rexxmathlib.library',0,-30,0)

/* Set up the months table - from names to numbers, */
months. = 0
months.jan = 1
months.feb = 2
months.mar = 3
months.apr = 4
months.may = 5
months.jun = 6
months.jul = 7
months.aug = 8
months.sep = 9
months.oct = 10
months.nov = 11
months.dec = 12

/* and now from numbers to days/month & print names */
months.1 = 'January'
months.1.days = 31
months.2 = 'February'
months.2.days = 1   /* Fixed later */
months.3 = 'March'
months.3.days = 31
months.4 = 'April'
months.4.days = 30
months.5 = 'May'
months.5.days = 31
months.6 = 'June'
months.6.days = 30
months.7 = 'July'
months.7.days = 31
months.8 = 'August'
months.8.days = 31
months.9 = 'September'
months.9.days = 30
months.10 = 'October'
months.10.days = 31
months.11 = 'November'
months.11.days = 30
months.12 = 'December'
months.12.days = 31      /* Not needed, but here for completeness */

cdir = Pragma('D')  /* Get Current Directory */

/* Open Config File, Find Out Data Base Name, Read In Data */
if exists(configfile) then
  do
    CFValid = true
    call GetConfig
  end
else if exists("S:"||configfile) then
  do
    CFValid = true
    configfile = "S:"||configfile
    call GetConfig
  end
else
  do
    CFValid = false
    call PostMsg(wx1+50,wy1+50,"WARNING!!\\\No Standard Config File Found\You Will Be Asked For One\\IF THERE IS NONE, Hit Cancel",ScreenID)
    call Delay(250)
    call PostMsg
    do until(CFValid)
      configfile = GetFile(wx1+50,wy1+50,,configfile,"Select Config File, If It Exists",ScreenID)
      if exists(configfile) | configfile = "" then CFValid = true
    end
    if configfile ~= "" then call GetConfig
    else CFValid = false
  end

/* Get the current date for later use*/
parse value date('Normal') with curday mymonth myyear
curday = curday + 0
thisyear = myyear
thismonth = upper(mymonth)

/* Open our window */
call MainWindow(CALHOST,CALPORT,false)

/* Set up meuns */
call SetUpMenus

/*  Get the required calendar */
call cal

call SetUpCal
if thisyear = myyear & months.thismonth = mymonth then
  do
    daysel = right(curday,2,'0')
    previousday = daysel
  end
else
  do
    daysel = 0
    previousday = 0
  end
showingday = false
call SetUpDay
call DayDisplay
if pm then call PostMsg
if newscreen then rtn = ScreenToFront(ScreenID)

time2go = false
time2exit = false
all_ok = true
buttondown = false

if pm then
  do
    call PostMsg
    pm = false
  end

/*
** Handle the incoming events
*/
do until(time2exit)
  t = waitpkt(CALPORT)
  do i = 1
    p = getpkt(CALPORT)
    if c2d(p) = 0 then leave i
    command = getarg(p)
    select
      when left(command,7) = "DAYINFO" then
        do
          parse value command with cmd "." j
          dailynote.j = getarg(p,1)
          t = reply(p,0)
        end
      when command = "ACTIVEWINDOW" then
        do
          nxtarg = getarg(p,1)
          t = reply(p,0)
          parse value nxtarg with wx1 wy1
        end
      when command = "MOUSEBUTTONS" then
        do
          if buttondown then
            do
              nxtarg = getarg(p,1)
              t = reply(p,0)
              parse value nxtarg with mousx mousy wx wy
              buttondown = false
              /* say mousx mousy */
              if IconOn then
                do
                  IconOn = false
                  ix1 = wx
                  iy1 = wy
                  call CloseWindow(CALHOST,"CONTINUE")
                  call MainWindow(CALHOST,CALPORT,true)
                  call SetUpMenus
                  call SetUpCal
                  call SetUpDay
                  call DayDisplay
                end
              else
                wx1 = wx
                wy1 = wy
                if mousx > x1 & mousx < x2 & mousy > y1 & mousy < y2 then
                  do
                    thisday = DaySelected(mousx,mousy)
                    if thisday ~= daysel & thisday > 0 then
                      do
                        pm = true
                        call PostMsg(wx1+50,wy1+50,"WORKING!!",ScreenID)
                        daysel = right(thisday,2,'0')
                        call ProcessDay("FINISHPD")
                      end
                  end
            end
          else
           do
             t = reply(p,0)
             buttondown = true
           end
        end
      when command = "DECD" then
        do
          t = reply(p,0)
          if ~Lock then
            do
              Lock = true
              dayarg = daysel-1
              if dayarg > 0 then call ProcessDay("D")
              else Lock = false
            end
        end
      when command = "INCD" then
        do
          t = reply(p,0)
          if ~Lock then
            do
              Lock = true
              dayarg = daysel+1
              if dayarg <= curdays then call ProcessDay("D")
              else Lock = false
            end
        end
      when command = "DECM" then
        do
          t = reply(p,0)
          if ~Lock then
            do
              Lock = true
              moryarg = month-1
              morycmd = "MONTH"
              if moryarg > 0 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
              else Lock = false
            end
        end
      when command = "INCM" then
        do
          t = reply(p,0)
          if ~Lock then
            do
              Lock = true
              moryarg = month+1
              morycmd = "MONTH"
              if moryarg <= 12 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
              else Lock = false
            end
        end
      when command = "DECY" then
        do
          t = reply(p,0)
          if ~Lock then
            do
              Lock = true
              moryarg = year-1
              morycmd = "YEAR"
              if moryarg > 0 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
              else Lock = false
            end
        end
      when command = "INCY" then
        do
          t = reply(p,0)
          if ~Lock then
            do
              Lock = true
              moryarg = year+1
              morycmd = "YEAR"
              if moryarg <= 9999 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
              else Lock = false
            end
        end
      when command = "MONTH" | command = "YEAR" then
        do
          moryarg = getarg(p,1)
          t = reply(p,0)
          morycmd = command
          if ~yeartrigger then call ProcessDay("M-OR-Y")
          else call ReadHost(CALHOST,CALPORT,"M-OR-Y")
        end
      when command = "M-OR-Y" then
        do
          t = reply(p,0)
          if ~yeartrigger then call Processday2
          parse value moryarg with input .
          yeartrigger = false
          if morycmd = "YEAR" then
            do
              yeartrigger = true
              year = input
              call ReadGadget(CALHOST,"MONTH")
            end
          else
            do
              month = input
              call RemoveGadget(CALHOST,"MONTH")
              call RemoveGadget(CALHOST,"YEAR")
              call SetAPen(CALHOST,1)
              call RectFill(CALHOST,x1-offset,y1-offset,x2+offset,y2+offset)
              call cal
              call SetUpCal
              if daysel > curdays then
                do
                  daysel = curdays
                  previousday = curdays
                end
              call DayDisplay
              call SetUpDay
            end
        end
      when command = "DAY" then
        do
          dayarg = getarg(p,1)
          t = reply(p,0)
          call ProcessDay("D")
        end
      when command = "D" then
        do
          t = reply(p,0)
          call ProcessDay2
          parse value dayarg with daysel .
          if daysel = "" then daysel = 0
          if ~datatype(daysel,"Numeric") then
            do
              call postmsg(wx1+50,wy1+50,"WARNING!!\\Day must be numeric.",ScreenID)
              call delay(200)
              call postmsg
            end
          else
            do
              daysel = right(daysel,2,'0')
              call RemoveGadget(CALHOST,"DAY")
              call SetAPen(CALHOST,1)
              call RectFill(CALHOST,263,32,287,47)
              call DayDisplay
              call SetUpDay
              previousday = daysel
            end
        end
      when command = "FINISHPD" then
        do
          t = reply(p,0)
          call ProcessDay2
          call SetupDay
          previousday = daysel
          call DayDisplay
        end
      when command = "TODAY" then
        do
          t = reply(p,0)
          call RemoveGadget(CALHOST,"TODAY")
          call SetAPen(CALHOST,1)
          call RectFill(CALHOST,279,86,382,107)
          call AddGadget(CALHOST,282,87,"TODAY"," Today is: \"||date('n'),"%d")
        end
      when command = "ICON" then
        do
          nxtarg = getarg(p,1)
          t = reply(p,0)
          parse value nxtarg with wx1 wy1
          IconOn = true
          showingday = false
          daybg = false
          call CloseWindow(CALHOST,"CONTINUE")
          idcmp = 'MOUSEBUTTONS'
          flags = 'WINDOWDRAG+WINDOWDEPTH+BACKFILL'
          if newscreen then call ScreenToBack(ScreenID)
          call OpenWindow(CALHOST,ix1,iy1,125,23,idcmp,flags,"Cal-Pal")
          call ModifyHost(CALHOST,MOUSEBUTTONS,"%l%1%x %y %f %e")
          call SetDrMd(CALHOST,"JAM1")
          call SetAPen(CALHOST,2)
          call Move(CALHOST,7,18)
          call Text(CALHOST,"  Click Here")
        end
      when command = "FINDSTR" then
        do
          t = reply(p,0)
          searchstr = Request(wx1+50,wy1+50,"Enter String to Find",searchstr,"FIND IT","CANCEL",ScreenID)
          if searchstr ~= "" then call FindStr(0)
          if foundit then
            do
              pm = true
              call PostMsg(wx1+50,wy1+50,"WORKING!!",ScreenID)
              if mtmp ~= month | ytmp ~= year then
                do
                  year = ytmp
                  month = mtmp
                  call RemoveGadget(CALHOST,"MONTH")
                  call RemoveGadget(CALHOST,"YEAR")
                  call SetAPen(CALHOST,1)
                  call RectFill(CALHOST,x1-offset,y1-offset,x2+offset,y2+offset)
                  call cal
                  call SetUpCal
                  call DayDisplay
                  call SetUpDay
                end
              daysel = dsea
              call ProcessDay("FINISHPD")
            end
          else
            do
              call PostMsg(wx1+50,wy1+50,"Requested String NOT Found!!",ScreenID)
              call delay(150)
              call PostMsg
            end
        end
      when command = "FINDNXT" then
        do
          t = reply(p,0)
          if searchstr ~= "" then
            do
              call FindStr(dlast)
              if foundit then
                do
                  if mtmp ~= month | ytmp ~= year then
                    do
                      year = ytmp
                      month = mtmp
                      call RemoveGadget(CALHOST,"MONTH")
                      call RemoveGadget(CALHOST,"YEAR")
                      call SetAPen(CALHOST,1)
                      call RectFill(CALHOST,x1-offset,y1-offset,x2+offset,y2+offset)
                      call cal
                      call SetUpCal
                      call DayDisplay
                      call SetUpDay
                    end
                  pm = true
                  call PostMsg(wx1+50,wy1+50,"WORKING!!",ScreenID)
                  daysel = dsea
                  call ProcessDay("FINISHPD")
                end
              else
                do
                  call PostMsg(wx1+50,wy1+50,"Requested String NOT Found!!",ScreenID)
                  call delay(150)
                  call PostMsg
                end
            end
        end
      when command = "CLOSEWINDOW" | command = "QUITCP" then
        do
          if command = "CLOSEWINDOW" then
            do
              nxtarg = getarg(p,1)
              parse value nxtarg with wx1 wy1
            end
          t = reply(p,0)
          if ~saved then
            do
              result = Request(wx1+50,wy1+50,"WARNING!!\\Quit Without Saving?",,"   YES   "," NO WAY! ",ScreenID)
              if result = "OKAY" then
                do
                  call MyQuit(CALHOST)
                  do until(~showlist('P','CALHOST'))
                    call delay(10)
                  end
                  exit
                end
            end
          else
            do
              call MyQuit(CALHOST)
              do until(~showlist('P','CALHOST'))
                call delay(10)
              end
              exit
            end
        end
      when command = "SYSINFO" then
        do
          t = reply(p,0)
          call Request(wx1+50,wy1+50,sysinfo,,"Done",ScreenID)
        end
      when command = "SAVE" then
        do
          t = reply(p,0)
          if saved then
            do
              call PostMsg(wx1+50,wy1+50,"WARNING!!\\No Changes to Data Base\File Not Written",ScreenID)
              call Delay(150)
              call PostMsg
            end
          else
            do
              if ~CFValid then
                do until(CFValid)
                  configfile = GetFile(wx1+50,wy1+50,cdir,OrigConfigfile,"Enter Config File Name",ScreenID)
                  if configfile ~= "" then
                    do
                      parse value GetFName(database) with dbdir " " dbname
                      if dbdir = "&&NULL" then dbdir = cdir
                      if dbname = "&&NULL" then dbname = ""
                      database = GetFile(wx1+50,wy1+50,dbdir,dbname,"Enter Data Base Name",ScreenID)
                      if database ~= "" then CFValid = true
                    end
                end
              /* Write out data base & config file */
              if showingday then call ProcessDay("FINISHWD")
              else call WriteData
            end
        end
      when command = "FINISHWD" then
        do
          t = reply(p,0)
          call ProcessDay2
          call WriteData
        end
      when command = "SAVEAS" THEN
        do
          t = reply(p,0)
          CFValid = false
          do until(CFValid)
            configfile = GetFile(wx1+50,wy1+50,cdir,OrigConfigfile,"Enter Config File Name",ScreenID)
            if configfile ~= "" then
              do
                parse value GetFName(database) with dbdir " " dbname
                if dbdir = "&&NULL" then dbdir = cdir
                if dbname = "&&NULL" then dbname = ""
                database = GetFile(wx1+50,wy1+50,dbdir,dbname,"Enter Data Base Name",ScreenID)
                if database ~= "" then CFValid = true
              end
          end
          if showingday then
            do
              saving = true
              call ProcessDay("FINISHWD")
            end
          else call WriteData
        end
      when command = "SPEAKNOTES" then
        do
          t = reply(p,0)
          if ~voice then
            do
              call PostMsg(wx1+50,wy1+50,"WARNING!!\\SPEAK Handler Not Found")
              call delay(150)
              call PostMsg
            end
          else
            do
              void = true
              call open('out',SFile,'Write')
              do i = 1 to 15
                if dailynote.i ~= "" then
                  do
                    call writeln('out',dailynote.i)
                    void = false
                  end
              end
              call close('out')
              if ~void then address command "type " SFile " to speak:opt/n/s135"
              call delete(SFile)
            end
        end
      when command = "SETPARMS" then
        do
          t = reply(p,0)
          tmpsd = seadirection
          tmpsy = seayear
          tmpsm = seamonth
          call SearchWindow
        end
      when command = "SEAOK" then
        do
          t = reply(p,0)
          call MyQuit(CPSHOST)
          seadirection = tmpsd
          seayear = tmpsy
          seamonth = tmpsm
        end
      when command = "SEACAN" then
        do
          t = reply(p,0)
          call MyQuit(CPSHOST)
        end
      when command = "SEADIR" then
        do
          t = reply(p,0)
          if tmpsd = "Forward" then tmpsd = "Reverse"
          else tmpsd = "Forward"
          call RemoveGadget(CPSHOST,"SEADIR")
          call RectFill(CPSHOST,69,19,130,36)
          call AddGadget(CPSHOST,70,20,SEADIR,tmpsd,"%d")
        end
      when command = "SEAYR" then
        do
          t = reply(p,0)
          if tmpsy = "This Year" then tmpsy = "All Years"
          else tmpsy = "This Year"
          call RemoveGadget(CPSHOST,"SEAYR")
          call RectFill(CPSHOST,60,38,139,55)
          call AddGadget(CPSHOST,61,39,SEAYR,tmpsy,"%d")
        end
      when command = "SEAMN" then
        do
          t = reply(p,0)
          if tmpsm = "This Month" then tmpsm = "All Months"
          else tmpsm = "This Month"
          call RemoveGadget(CPSHOST,"SEAMN")
          call RectFill(CPSHOST,56,57,148,74)
          call AddGadget(CPSHOST,57,58,SEAMN,tmpsm,"%d")
        end
      otherwise t = reply(p,0)
      end
  end
end


/*
**  Main body of calendar procedure
**
*/

cal:

/* Get a month to work with */
if datatype(month, 'Numeric') then mymonth = month
else do
   if month ~= "" then mymonth = month
   mymonth = upper(left(mymonth, 3))
   mymonth = months.mymonth
   end
mymonth = mymonth+0
if months.mymonth.days = 0 then do
   say "Month must be a month name or a number from 1 to 12, not" month
   if pm then call postmsg
   call MyQuit(CALHOST)
   do until(~showlist('P','CALHOST'))
     call delay(10)
   end
   exit 10
   end

/* Got a valid month, now see about the year */
select
   when year = "" then nop   /* myyear is already right */
   when ~datatype(year, 'Numeric') then do
      say "Year must be a number between 1 and 9999, not" year
      if pm then call postmsg
      call MyQuit(CALHOST)
      do until(~showlist('P','CALHOST'))
        call delay(10)
      end
      exit 10
      end
   when length(year) = 2 then myyear = '19'year
   otherwise myyear = year
   end

if myyear < 1 | myyear > 9999 then do
   say "Year must be between 1 and 9999 inclusive, not" myyear
   if pm then call postmsg
   call MyQuit(CALHOST)
   do until(~showlist('P','CALHOST'))
     call delay(10)
   end
   exit 10
   end

/* Figure out what day of the week that month started on */
firstday = jan1(myyear)

/* Get difference in weekdays between this year & next */
fudge = (jan1(myyear + 1) + 7 - firstday) // 7

select
   /* this is a regular year */
   when fudge = 1 then months.2.days = 28

   /* This is a leap year */
   when fudge = 2 then months.2.days = 29

   /* Otherwise, it must be 1752! */
   otherwise
      months.2.days = 29
      months.9.days = 19
   end

do i = 1 to mymonth - 1
   firstday = firstday + months.i.days
   end

firstday = firstday // 7      /* Got the day of the week */

/*
 * Now, go from that to the name of a day of the week. This table is also
 * used for formatting the output. The line at the top of the body consists
 * of these things concatenated together, with a space in between them.
 * The length of that string is the width of the calendar. Finally, we
 * line the numbers up under the last character of each name. All names
 * _must_ be the same length for this to work.
 */
daynames.0 = 'Sun'
 daynames.0.x = 14
daynames.1 = 'Mon'
 daynames.1.x = 46
daynames.2 = 'Tue'
 daynames.2.x = 78
daynames.3 = 'Wed'
 daynames.3.x = 110
daynames.4 = 'Thu'
 daynames.4.x = 142
daynames.5 = 'Fri'
 daynames.5.x = 175
daynames.6 = 'Sat'
 daynames.6.x = 207

indxday = firstday
firstday = daynames.firstday      /* and now it's name */

/* Get number of days in this month */
curdays = months.mymonth.days

/* Next, we set up the header for the calendar. */
headerline = daynames.0
do i = 1 to 6
   headerline = headerline daynames.i
   end
linelength = length(headerline)         /* width of calendar */

/* Set up the header for the calender */
lines.1 = center(months.mymonth myyear, linelength)
lines.2 = " "
lines.3 = headerline
linecount = 4   /* First line of body of calendar */

/* Now set up to put together lines of the body */
maxline = linecount + 5         /* 6 weeks on a monthly calendar, max */
do i = linecount + 1 to maxline
   lines.i = ""
   end

width = length(daynames.0)
indxy = 50
loc.1.x = daynames.indxday.x
loc.1.xo = loc.1.x+doffx
loc.1.y = indxy
loc.1.yo = indxy+doffy
lines.linecount = right(1, index(headerline, firstday) - 1 + width)
do i = 2 to curdays
   if i > 2 & curdays < 20 then day = i + 11
   else day = i

   if length(lines.linecount) + width <= linelength then
      do
        lines.linecount = lines.linecount right(day, width)
        indxday = indxday + 1
        loc.i.x = daynames.indxday.x
        loc.i.xo = loc.i.x+doffx
        loc.i.y = indxy
        loc.i.yo = indxy+doffy
      end
   else do
      linecount = linecount + 1
      lines.linecount = right(day, width)
      indxy = indxy + doffy
      indxday = 0
      loc.i.x = daynames.indxday.x
      loc.i.xo = loc.i.x+doffx
      loc.i.y = indxy
      loc.i.yo = indxy+doffy
      end
end
return

/*
 * jan1 - returns the day of the week that january first falls on for
 *   any specific year, 1 through 9999 (assuming they don't change
 *   the rules again).
 */
jan1: procedure
   arg year

   /* Julian calendar; one extra day every four years */
   day = 4 + year + (year + 3) % 4

   /* Gregorian calendar - lose three days over four centuries */
   if year > 1800 then do
      day = day - (year - 1701) % 100
      day = day + (year - 1601) % 400
      end

   /* And the instant changeover in 1752 */
   if year > 1752 then
      day = day + 3

   return day // 7


/*  Setup the host and open window for Cal-Pal display  */

  MainWindow:
  arg hostcntl,hostport,onlywindow

  if ~onlywindow then
    do
      if newscreen then
        do
          chfile = "T:++Cal-S-Win.rexx"
          call MakeScreen
        end
      else chfile = "T:++Cal-Win.rexx"
      if ~exists(chfile) then
        do
          call open('out',chfile,'Write')
          if newscreen then call writeln('out',"/**/;call createhost(" || hostcntl || "," || hostport || ",'" || ScreenID || "')")
          else call writeln('out',"/**/;call createhost(" || hostcntl || "," || hostport || ")")
          call close('out')
        end
      address AREXX chfile
      mp = openport(hostport)
      address command "c:WaitForPort" hostport
      do until(showlist("P",hostcntl) & showlist("P",hostport))
        call delay(10)
      end
    end
  idcmp = 'GADGETUP+MOUSEBUTTONS+CLOSEWINDOW+MENUPICK+MOUSEMOVE+ACTIVEWINDOW'
  flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+BACKFILL'

  call OpenWindow(hostcntl,wx1,wy1,405,400,idcmp,flags,"Calendar Pal")
  if newscreen then
    do
      call SetRGB4(hostcntl,0,0,0,8)
      call SetRGB4(hostcntl,1,7,7,7)
      call SetRGB4(hostcntl,2,0,0,0)
      call SetRGB4(hostcntl,3,15,15,15)
    end
  call ModifyHost(hostcntl,MOUSEMOVE,"%l%1%x %y")
  call ModifyHost(hostcntl,MOUSEBUTTONS,"%l%1%x %y %f %e")
  call ModifyHost(hostcntl,CLOSEWINDOW,"%l%1%f %e")
  call ModifyHost(hostcntl,ACTIVEWINDOW,"%l%1%f %e")
  call AddGadget(hostcntl,290,68,"ICON"," Iconify ","%d%1%f %e")
  call AddGadget(hostcntl,282,87,"TODAY"," Today is: \"||date('n'),"%d")

  return 0

/* Was a day selected with the mouse?  Return day number or 0 for none. */
DaySelected:
  arg dsx, dsy
  do i = 1 to 7
    if dsx >= loc.i.x & dsx <= loc.i.xo then
      do
        do ii = i to curdays by 7
          if dsy >= loc.ii.y & dsy <= loc.ii.yo then return ii
        end
        return 0
      end
  end
  return 0

/* Display the calendar */
SetUpCal:

/* Output the calendar outline */
call SetDrMd(CALHOST,JAM1)
call SetAPen(CALHOST,2)
x1 = 10
x2 = 250
y1 = 13
offset = 3
y2 = 25+(linecount*11)
call Move(CALHOST,x1,y1)
call Draw(CALHOST,x2,y1)
call Draw(CALHOST,x2,y2)
call Draw(CALHOST,x1,y2)
call Draw(CALHOST,x1,y1)
x1 = x1 + offset
y1 = y1 + offset
x2 = x2 - offset
y2 = y2 - offset
call Move(CALHOST,x1,y1)
call Draw(CALHOST,x2,y1)
call Draw(CALHOST,x2,y2)
call Draw(CALHOST,x1,y2)
call Draw(CALHOST,x1,y1)
call Flood(CALHOST,1,x1+1,y1+1)

/* Output calendar */
call SetAPen(CALHOST,1)
do i = 1 to linecount
  call Move(CALHOST,20,(15+(i*11)))
  call Text(CALHOST,lines.i)
end
month = right(mymonth,2,'0')
year = right(word(myyear,1),4,'0')

/* Outline days with notes */
call SetAPen(CALHOST,0)
do i = 1 to curdays
  j = right(i,2,'0')
  if datatype(note.year.month.j.0,'Numeric') & note.year.month.j.0 > 0 then
    call Box(i)
end
call SetAPen(CALHOST,2)
call AddGadget(CALHOST,300, 34,"MONTH",month,"%d%1%g",35)
call AddGadget(CALHOST,303, 49,"DECM","<","%d")
call AddGadget(CALHOST,320, 49,"INCM",">","%d")
call AddGadget(CALHOST,352, 34,"YEAR",year,"%d%1%g",40)
call AddGadget(CALHOST,358, 49,"DECY","<","%d")
call AddGadget(CALHOST,375, 49,"INCY",">","%d")
call AddGadget(CALHOST,261, 49,"DECD","<","%d")
call AddGadget(CALHOST,278, 49,"INCD",">","%d")
call Move(CALHOST,300,26)
call Text(CALHOST,"Month  Year")

return

/* Set up the day we are focused on */
SetUpDay:
  call SetAPen(CALHOST,2)
  if previousday > 0 then
    do
      if datatype(note.year.month.previousday.0,'Numeric') & note.year.month.previousday.0 > 0 then
        call SetAPen(CALHOST,0)
      call Box(previousday+0)
    end
  call SetAPen(CALHOST,3)
  if daysel > 0 then call Box(daysel+0)
  call SetAPen(CALHOST,2)
  if daysel = 0 then call Addgadget(CALHOST,265,34,"DAY","","%d%1%g",19)
  else call Addgadget(CALHOST,265,34,"DAY",daysel,"%d%1%g",19)
  call Move(CALHOST,263,26)
  call Text(CALHOST,"Day")
  return

/*Set up menus */
SetUpMenus:

  call AddMenu(CALHOST,"System ")
  call AddItem(CALHOST,"About  ","SYSINFO")
  call AddItem(CALHOST,"Save   ","SAVE","S")
  call AddItem(CALHOST,"Save As","SAVEAS")
  call AddItem(CALHOST,"Quit   ","QUITCP","Q")
  call AddMenu(CALHOST,"Search ")
  call AddItem(CALHOST,"Search Parms","SETPARMS","P")
  call AddItem(CALHOST,"Find String ","FINDSTR","F")
  call AddItem(CALHOST,"Find Next   ","FINDNXT","N")
  call AddMenu(CALHOST,"Speak Notes")
  call AddItem(CALHOST,"Speak Notes","SPEAKNOTES","R")
  return

/* Display current day's data */
DayDisplay:
  if daysel = 0 then return
  if ~daybg then
    do
      dayx1 = 10
      dayx2 = 395
      dayy1 = 125
      dayy2 = 385
      call Move(CALHOST,dayx1,dayy1)
      call Draw(CALHOST,dayx2,dayy1)
      call Draw(CALHOST,dayx2,dayy2)
      call Draw(CALHOST,dayx1,dayy2)
      call Draw(CALHOST,dayx1,dayy1)
      call Flood(CALHOST,1,dayx1+1,dayy1+1)
      daybg = true
    end
  do i = 1 to 15
    dailynote.i = ""
  end
  DayNotes = note.year.month.daysel.0
  /* say "DayNotes = " DayNotes "Daysel = " daysel */
  if datatype(DayNotes,'Numeric') then
    do i = 1 to DayNotes while DayNotes > 0
      dailynote.i = note.year.month.daysel.i
    end
  do i = 1 to 15
    if showingday then call RemoveGadget(CALHOST,DAYINFO.i)
    call AddGadget(CALHOST,13,130+((i-1)*17),DAYINFO.i,dailynote.i,"%d%1%g",376)
  end
  if pm then call PostMsg
  showingday = true
  return

/* Get configuration (name of data base) */
GetConfig:

call open('cf',configfile,"Read")
CFVerify = readln('cf')
if CFVerify ~= VerifyKey & CFVerify ~= OldVerifyKey then
  do
    CFValid = false
    call PostMsg(wx1+50,wy1+50,"WARNING!!\\Config File Not Valid\No Data Base Read In",ScreenID)
    call delay(200)
    call PostMsg
    call close('cf')
    return
  end
database = readln('cf')
if exists(database) then  /* Read in data base */
  do
    call open('db',database,'Read')
    do until(eof('db'))
      input = readln('db')
      parse value input with yin '.' min '.' din '.' numnotes '.'
      yin = right(yin,4,'0')
      min = right(min,2,'0')
      din = right(din,2,'0')
      if numnotes ~= "" then
        do
          if note.yin.min.din ~= "Y" then
            do
              note.yin.min.din = "Y"
              ym = ym + 1
              yearmonths.ym = yin||"."||min||"."||din
            end
          note.yin.min.din.0 = numnotes
          do i = 1 to numnotes
            note.yin.min.din.i = readln('db')
          end
        end
    end
    call close('db')
  end
else
  do
    CFVaild = false
    call PostMsg(wx1+50,wy1+50,"WARNING!!\\Data Base File Not Found\No Data Base Read In",ScreenID)
    call delay(200)
    call PostMsg
  end
call close('cf')
return

/* Write Out the Data Base */
WriteData:
  if ym = 0 then
    do
      call PostMsg(wx1+50,wy1+50,"WARNING!!\\No Data Base Written\No Data Present",ScreenID)
      call delay(200)
      call PostMsg
      return
    end
  call PostMsg(wx1+50,wy1+50,"Writing Data Base",ScreenID)
  call SortYears
  call open('cf',configfile,'Write')
  call writeln('cf',VerifyKey)
  call writeln('cf',database)
  call close('cf')
  call open('db',database,'Write')
  do i = 1 to ym
    parse value yearmonths.i with yout "." mout "." dout
    if note.yout.mout.dout.0 > 0 then
      do
        call writeln('db',yearmonths.i||'.'||note.yout.mout.dout.0||'.')
        do j = 1 to note.yout.mout.dout.0
          call writeln('db',note.yout.mout.dout.j)
        end
      end
  end
  call close('db')
  call PostMsg
  saved = true
  return

/* Separate Directory from file name */
GetFName: procedure

  parse arg combo .
  lencombo = length(combo)
  slash = lastpos("/",combo)
  if slash > 0 then
    do
      if slash < lencombo then return insert(" ",delstr(combo,slash,1),slash-1)
      else return combo || " &&NULL"
    end
  colon = lastpos(":",combo)
  if colon > 0 then
    do
      if colon < lencombo then return insert(" ",combo,colon)
      else return combo || " &&NULL"
    end
  return "&&NULL " || combo

/* Draw a box around the currently selected day */
Box:

  parse arg ii
  bx = loc.ii.x+12
  bx2 = loc.ii.xo
  by = loc.ii.y
  by2 = loc.ii.yo
  call move(CALHOST,bx,by)
  call draw(CALHOST,bx2,by)
  call draw(CALHOST,bx2,by2)
  call draw(CALHOST,bx,by2)
  call draw(CALHOST,bx,by)
  return

/* Save any changes to daily notes */
ProcessDay:

  parse upper arg wheretogo
  if showingday then
    do i = 1 to 15
      call ReadGadget(CALHOST,DAYINFO.i)
    end
  call ReadHost(CALHOST,CALPORT,wheretogo)
  return

ProcessDay2:

  if ~showingday then
    do
      Lock = false
      return
    end
  k = 0
  do i = 1 to 15
    if dailynote.i ~= "" then
      do
        k = k + 1
        note.year.month.previousday.k = dailynote.i
      end
  end
  if k > 0 then
    do
      note.year.month.previousday.0 = k
      if note.year.month.previousday ~= "Y" then
        do
          note.year.month.previousday = "Y"
          ym = ym + 1
          yearmonths.ym = year||"."||month||"."||previousday
        end
    end
  else if note.year.month.previousday = "Y" then
    note.year.month.previousday.0 = 0
  saved = false
  Lock = false
  return

/* Find a string in the notes */
FindStr:
  parse arg dstart .
  foundit = false
  ytmp = year
  mtmp = month
  if dstart = 0 then call SortYears
  do i = 1 to ym while ym > 0
    parse value yearmonths.i with ysea '.' msea '.' dsea '.'
    if seayear = "All Years" then ytmp = ysea
    if seamonth = "All Months" then
      do
        if dstart > 0 then
          do
            if msea > mtmp then
              do
                dstart = .9
                mtmp = msea
              end
          end
        else mtmp = msea
      end
    if seadirection = "Forward" & ysea = ytmp & msea = mtmp & dsea > dstart then
      do ii = 1 to note.ysea.msea.dsea.0 while(note.ysea.msea.dsea.0 > 0)
        if index(note.ysea.msea.dsea.ii,searchstr) > 0 then
          do
            foundit = true
            dlast = dsea
            leave i
          end
      end
    else if seadirection = "Reverse" & ysea = ytmp & msea = mtmp & dsea < dstart then
      do ii = 1 to note.ysea.msea.dsea.0 while(note.ysea.msea.dsea.0 > 0)
        if index(note.ysea.msea.dsea.ii,searchstr) > 0 then
          do
            foundit = true
            dlast = dsea
            leave i
          end
      end
  end
  return

/* Open Search Parameter Window */
SearchWindow:

 if newscreen then spfile = "T:++CAl-SSea.rexx"
 else spfile = "T:++Cal-Sea.rexx"
 if ~exists(spfile) then
   do
     call open('out',spfile,"Write")
     call writeln('out',"/* Start Rexx Source */")
     if newscreen then call writeln('out',"x = createhost(" || CPSHOST || "," || CALPORT || ",'" || ScreenID || "')")
     else call writeln('out',"x = createhost(" || CPSHOST || "," || CALPORT || ")")
     call close('out')
   end
  address AREXX spfile
  do until(showlist("P",CPSHOST))
    call delay(10)
  end

  idcmp = 'GADGETUP'
  flags = 'WINDOWDRAG+BACKFILL'

  call OpenWindow(CPSHOST,wx1+50,wy1+50,200,100,idcmp,flags,"Search Parameters")
  if newscreen then
    do
      call SetRGB4(CPSHOST,0,0,0,8)
      call SetRGB4(CPSHOST,1,7,7,7)
      call SetRGB4(CPSHOST,2,0,0,0)
      call SetRGB4(CPSHOST,3,15,15,15)
    end
  call SetDrMd(CPSHOST,"JAM1")
  call SetAPen(CPSHOST,1)
  call SetOPen(CPSHOST,1)
  call AddGadget(CPSHOST,70,20,SEADIR,tmpsd,"%d")
  call AddGadget(CPSHOST,61,39,SEAYR,tmpsy,"%d")
  call AddGadget(CPSHOST,57,58,SEAMN,tmpsm,"%d")
  call AddGadget(CPSHOST,20,80,SEAOK,"  USE  ","%d")
  call AddGadget(CPSHOST,110,80,SEACAN," CANCEL ","%d")

  return

/* Sort the year/month index */
SortYears:
  if ym <= 1 then return
  do i = 2 to ym
    do ii = 1 to i-1
      if yearmonths.i < yearmonths.ii then
        do
          sorttmp = yearmonths.ii
          yearmonths.ii = yearmonths.i
          yearmonths.i = sorttmp
        end
    end
  end
  return

/* Let's quit a window */
MyQuit:

  parse arg quithost .
  if quithost = 'CALHOST' then
    do
      if newscreen then
        do
          call CloseWindow(CALHOST)
          call CloseScreen(ScreenID)
          exit
        end
      else call Quit(CALHOST)
    end
  else call Quit(quithost)
  return

/* Open interlace screen */
MakeScreen:

  if newscreen then modes = 'HIRES+LACE+SCREENBEHIND'
  else modes = 'HIRES+LACE'
  rtn = OpenScreen(0,2,modes,'Cal-Pal',ScreenID)
  return